perm filename PX[PIC,LCS] blob sn#081723 filedate 1974-01-12 generic text, type T, neo UTF8
00100		SUBROUTINE PLOU
00200
00300		COMMON/PLT/JX,JY,JPL,PLT,REV,RINV,IROT,RLR,RUD,CONST
00400		1 ,JREV,JINV,KA,KB,KC,KD,RTO,JA,JB,JAR,JBR
00500	
00600		DIMENSION IDP1(4000),INP(10,20)
00700
00800		COMMON /LISTC/LIST(6,1000),LIST5(0/1000),NEWEND,LO
00900		COMMON/COMMAC/BCLIP,TCLIP,BITS,IWID,LINLEN,FLINE,LLINE,
01000		1 LSIDE,RSIDE,DTA,HYSTAB(1)
01100		INTEGER FLINE,RSIDE
01200		DATA NEWX/0/,NCNT/0/
01300		RTO=6
01600		JX=0
01700		JY=0
01800		JPL=1
01900
02000	1001	FORMAT(A1,9F)
02100	1000	FORMAT(' D(ISPLAY) P(LOT) OR M(OVE)?  HORIZ.%,VERT.%,
02200		1 FOR CLEAR AREA L-R-BOT-TOP%   REV=1, INV=1'/)
02220	1	JAR=0
02260		JBR=0
02300		TYPE 1000
02400		ACCEPT 1001,WHICH,RLR,RUD,A,B,C,D,REV,RINV,ROT
02410		IF(WHICH.NE.'T')GO TO 3002
02420		DO 4002 K=1,NCNT
02430	4002	TYPE 5002,(INP(NA,K),NA=1,10)
02440		GO TO 1000
02450	3002	IF(NCNT.LT.20.AND.WHICH.NE.WX)NCNT=NCNT+1
02460		REREAD 3,(INP(NA,NCNT),NA=1,10)
02465		WX=WHICH
02467	C  SO IT WON'T COUNT RETRIES.
02470	3	FORMAT(10A5)
02485	5002	FORMAT(1X10A5)
02500	C  FAC=SIZE BY 100'S, RLR=LEFT-RIGHT SIZE, RUD=UP-DOWN SIZE
02600	C-- D 0 0    0,50,0,50 CLEARS LOWER LFT QUAD. 50 100 50 100 UPR RT.
02610	C  TYPE 'T' TO GET BACK ALL INPUT LINES.
02700		IF(A+B+C+D.EQ.0)A=-1.
02800	C  'N'= PLOT, BUT NO X
02900		IF(WHICH.EQ.'M')GO TO 2002
03000		IF(RLR.EQ.0)RLR=100.
03100		IF(RUD.EQ.0)RUD=100.
03110		IROT=-1
03120		IF(ROT.EQ.0)GO TO 2002
03160		IROT=0
03180		RINV=RINV-1
03200	2002	RLR=RLR/100.
03300		RUD=RUD/100.
03400		IF(WHICH.NE.'D')GO TO 1002
03500		PLT=0
03600		JPL=3
03700	C  DPY IS 1/3 SIZE OF PLOT.
04100		GO TO 2000
04200	
04300	1002  IF(WHICH.NE.'P'.AND.WHICH.NE.'N')GO TO 1102
04400		PLT=-1
04500		IF(NEWX.NE.-1)CALL PLOTS(I)
04600		GO TO 2
04700	
04800	1102	IF(WHICH.NE.'M')GO TO 1000
04900		PLT=0
05000	C  MOVE PEN, L-R%, U-D
05500	2200	RX=JQC-JQA+.5
05600		RY=JQD-JQB+.5
05700		JX=RX*RLR
05800		JY=RY*RUD
06200		RLR=.01
06300		RUD=.01
06400		GO TO 67
06500	
06600	2	IF(WHICH.EQ.'N')GO TO 2000
06700		CALL PLOT(10,0,3)
06800	C  MAKES AN X
06900		CALL PLOT(-10,0,2)
07000		CALL PLOT(0,10,3)
07100		CALL PLOT(0,-10,2)
07200		CALL PLOT(0,0,3)
07300
07400	2000	IF(NEWEND.GT.1000) PAUSE 'NEWEND>1000'
07600	C NEXT KEEPS ORIG. SIZE FACTORS
08200	50	FORMAT(' DO YOU WANT THE FRAME ?'/)
08300		IF(PLT.EQ.0)GO TO 67
08400	60	TYPE 50
08500	65	FORMAT(' LFT=',I4,'   RT=',I4,'   BOT=',I4,'   TOP=',I4)
08600		ACCEPT 1001,ALFAB
08700	67	RA=LSIDE*(RTO*RLR)+.5
08800		RB=FLINE*(RTO*RUD)+.5
08900		RC=RSIDE*(RTO*RLR)+.5
09000		RD=LLINE*(RTO*RUD)+.5
09100		IF(NEWX.EQ.-1)GO TO 655
09200		JQA=RA
09300		JQB=RB
09400		JQC=RC
09500		JQD=RD
09600	655	JQX=JX
09700		JQY=JY
09800		JY=JY+120-RB
09900		JX=JX+36-RA
10000	C "ORIGINAL" POS IS SET 1ST TIME ONLY.
10100		JA=RA+JX
10200		JB=RB+JY
10300		JC=RC+JX
10400		JD=RD+JY
10500		IF(WHICH.EQ.'M')GO TO 671
10600		TYPE 657
10700	657	FORMAT(' OUTER LIMITS')
10800		TYPE 65,JA,JC,JB,JD
10900	C   OUTER COORDINATES
11000		JREV=(JA+JC)/JPL
11100		JINV=(JB+JD)/JPL
11200		KA=0
11300		KB=0
11400		KC=0
11500		KD=0
11600		IF(A)GO TO 671
11700		KA=JA+(JC-JA)*(A/100.)
11800		KB=JA+(JC-JA)*(B/100.)
11900		KC=JB+(JD-JB)*(C/100.)
12000		KD=JB+(JD-JB)*(D/100.)
12100		IF(KB.LT.KA.OR.KD.LT.KC)GO TO 1
12200		TYPE 656
12300	656	FORMAT(/' CLEAR AREA')
12400		TYPE 65,KA,KB,KC,KD
12500	C  CLEAR AREA COORDINATES
12600	671	NA=(JC-JA+2)/3
12800		NB=(JD-JB+2)/3
12900		NC=(JA+2)/3-380
13000		ND=(JB+2)/3-200
13100		IF(NEWX.NE.-1)CALL DPYSET(1,IDP1,4000)
13200		CALL SETPOG(1)
13300		CALL TYPLOC(-300,-611)
13400		CALL DPYBRT(6)
13405		MA=JA
13407		MB=JB
13410	CC	IF(IROT)GO TO 672
13420	CC	M=NC
13430	CC	NC=ND
13440	CC	ND=M
13450	C ROTATE THE FRAME TO LEFT 90 DEG.
13500	672	CALL AIVECT(NC,ND)
13503		JAR=0
13506		JBR=0
13510		JA=NA
13520		JB=0
13600		CALL LINES(2)
13610		JA=0
13613		JAR=0
13620		JB=NB
13700		CALL LINES(2)
13710		JA=-NA
13720		JB=0
13723		JBR=0
13800		CALL LINES(2)
13810		JA=0
13813		JAR=0
13820		JB=-NB
13900		CALL LINES(2)
14000		JA=MA
14100		JB=MB
14200		JBR=0
15500		CALL DPYOUT(1)
15600		IF(WHICH.NE.'M')GO TO 2683
15700	168	JY=JQY
15800		JX=JQX
15900		GO TO 1000
16000	2683	IF(A)GO TO 1683
16100		NA=KA/3-380
16200		NB=KB/3-380
16300		NC=KC/3-200
16400		ND=KD/3-200
16455		NPL=1
16460		IF(JPL.EQ.1)NPL=3
16500		IF(REV.EQ.0)GO TO 3683
16600		NA=JREV/NPL-KA/3-380
16700		NB=JREV/NPL-KB/3-380
16800	3683	IF(RINV.EQ.0)GO TO 4683
16900		NC=JINV/NPL-KC/3-200
17000		ND=JINV/NPL-KD/3-200
17100	4683	CALL DPYSET(2,LIST5,100)
17200		CALL DPYBRT(2)
17210		IF(IROT)GO TO 5683
17220		CALL ALINE(NC,NA,NC,NB)
17230		CALL AVECT(ND,NB)
17240		CALL AVECT(ND,NA)
17250		CALL AVECT(NC,NA)
17260		GO TO 6683
17300	5683	CALL ALINE(NA,NC,NB,NC)
17400		CALL AVECT(NB,ND)
17500		CALL AVECT(NA,ND)
17600		CALL AVECT(NA,NC)
17700	6683	CALL DPYOUT(2)
17800		KA=KA/JPL
17900		KB=KB/JPL
18000		KC=KC/JPL
18100		KD=KD/JPL
18200	1683	TYPE 683
18300	683	FORMAT(' OK?'/)
18400		ACCEPT 1001,NA
18500		IF(NA.EQ.'N')GO TO 168
18600		IF(PLT)GO TO 1681
18700	682	CALL CLRPOG(2)
18800		CALL SETPOG(1)
18810		NC=-380
18820		ND=-200
18830		IF(IROT)GO TO 684
18865		NC=NC+JX
18882		ND=ND+JY
18900	684	CALL AIVECT(NC,ND)
19100	681	IF(PLT.EQ.0)GO TO 68
19200	1681	IF(ALFAB.EQ.'N') GOTO 68
19250		NA=JA
19260		NB=JB
19300		CALL LINES(3)
19310		JA=JC
19400		CALL LINES(2)
19410		JB=JD
19500		CALL LINES(2)
19510		JA=NA
19600		CALL LINES(2)
19610		JB=NB
19700		CALL LINES(2)
19710	68	IF(IROT)GO TO 685
19720		NA=(JC-JA)/2-(JD-JB)/2
19730		JX=JX+NA
19740		JY=JY+NA
19770		CALL EXCH(JX,JY)
19800	685	JX=JX/JPL
19900		NEWX=-1
20000		JY=JY/JPL
20100		CALL PLTMAN
20110		JX=JQX
20120		JY=JQY
20150		WX=0
20200		END